Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue34/timetrav/ModCal.pas

Pascal/Delphi Source File | 1998-03-25 | 9.1 KB | 318 lines

unit ModCal;

interface

uses Classes, Controls, Messages, Windows, Forms, Graphics, StdCtrls,
  Grids, SysUtils, BaseDate;

type
  TDayOfWeek = 0..6;

  TModCal = class(TCustomGrid)
  private
    FDate: TMJD;
    FMonthOffset: Integer;
    FOnChange: TNotifyEvent;
    FReadOnly: Boolean;
    FStartOfWeek: TDayOfWeek;
    FUpdating: Boolean;
    FUseCurrentDate: Boolean;
    FCalSystem : TEnglishCalendar;
    function GetCellText(ACol, ARow: Integer): string;
    function GetDateElement(Index: Integer): Integer;
    procedure SetCalendarDate(Value: TMJD);
    procedure SetDateElement(Index: Integer; Value: Integer);
    procedure SetStartOfWeek(Value: TDayOfWeek);
    procedure SetUseCurrentDate(Value: Boolean);
    function StoreCalendarDate: Boolean;
  protected
    procedure Change; dynamic;
    procedure ChangeMonth(Delta: Integer);
    procedure Click; override;
    function DaysPerMonth(AYear, AMonth: Integer): Integer; virtual;
    function DaysThisMonth: Integer; virtual;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    function IsLeapYear(AYear: Integer): Boolean; virtual;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  public
    constructor Create(AOwner: TComponent); override;
    property CalendarDate: TMJD  read FDate write SetCalendarDate stored StoreCalendarDate;
    property CellText[ACol, ARow: Integer]: string read GetCellText;
    procedure NextMonth;
    procedure NextYear;
    procedure PrevMonth;
    procedure PrevYear;
    procedure UpdateCalendar; virtual;
  published
    property Align;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property Day: Integer index 3  read GetDateElement write SetDateElement stored False;
    property Enabled;
    property Font;
    property GridLineWidth;
    property Month: Integer index 2  read GetDateElement write SetDateElement stored False;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property ShowHint;
    property StartOfWeek: TDayOfWeek read FStartOfWeek write SetStartOfWeek;
    property TabOrder;
    property TabStop;
    property UseCurrentDate: Boolean read FUseCurrentDate write SetUseCurrentDate default True;
    property Visible;
    property Year: Integer index 1  read GetDateElement write SetDateElement stored False;
    property OnClick;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
  end;

implementation

constructor TModCal.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { defaults }
  FUseCurrentDate := True;
  FixedCols := 0;
  FixedRows := 1;
  ColCount := 7;
  RowCount := 7;
  ScrollBars := ssNone;
  Options := Options - [goRangeSelect] + [goDrawFocusSelected];
  fCalSystem := TEnglishCalendar.create;
  FDate := fCalSystem.MJDfromMSdate(Date);
  UpdateCalendar;
end;

procedure TModCal.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TModCal.Click;
var
  TheCellText: string;
begin
  inherited Click;
  TheCellText := CellText[Col, Row];
  if TheCellText <> '' then Day := StrToInt(TheCellText);
end;

function TModCal.IsLeapYear(AYear: Integer): Boolean;
begin
  Result := fCalSystem.IsLeapYear(aYear); //(AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;

function TModCal.DaysPerMonth(AYear, AMonth: Integer): Integer;
const
  DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  fCalSystem.IsLeapYear(ayear);
  result := fCalSystem.MonthLength[AMonth];
//  Result := DaysInMonth[AMonth];
//  if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
end;

function TModCal.DaysThisMonth: Integer;
begin
  Result := DaysPerMonth(Year, Month);
end;

procedure TModCal.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  TheText: string;
begin
  TheText := CellText[ACol, ARow];
  with ARect, Canvas do
    TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
      Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
end;

function TModCal.GetCellText(ACol, ARow: Integer): string;
var
  DayNum: Integer;
  First, Last, adjustment : integer;
begin
  if ARow = 0
    then  { day names at tops of columns }
      Result := ShortDayNames[(StartOfWeek + ACol) mod 7 + 1]
    else with fCalSystem do begin
      adjustment := 0;
      DayNum := FMonthOffset + ACol+ (ARow - 1) * 7;
      if YearDef.MonthObj[Month].hasMissingDays(First, Last)
        then begin
          adjustment := Last - First + 1;
          if DayNum > (First-1)
               then DayNum := DayNum + Adjustment;
          end;
      if (DayNum < 1) or (DayNum > (DaysThisMonth + adjustment))
        then Result := ''
        else Result := IntToStr(DayNum);
      end;
end;

function TModCal.SelectCell(ACol, ARow: Longint): Boolean;
begin
  if ((not FUpdating) and FReadOnly) or (CellText[ACol, ARow] = '') then
    Result := False
  else Result := inherited SelectCell(ACol, ARow);
end;

procedure TModCal.SetCalendarDate(Value: TMJD);
begin
  FDate := Value;
  UpdateCalendar;
  Change;
end;

function TModCal.StoreCalendarDate: Boolean;
begin
  Result := not FUseCurrentDate;
end;

function TModCal.GetDateElement(Index: Integer): Integer;
var
  YMD : TCalendarDate; //AYear, AMonth, ADay: Word;
begin
  YMD := FCalSystem.DecodeDate(FDate); //, AYear, AMonth, ADay);
  case Index of
    1: Result := YMD.Year;
    2: Result := YMD.Month;
    3: Result := YMD.Day;
    else Result := -1;
  end;
end;

procedure TModCal.SetDateElement(Index: Integer; Value: Integer);
var
//  AYear, AMonth, ADay: Word;
  YMD : TCalendarDate;
begin
  if Value > 0 then
    with YMD do begin
     YMD := fCalSystem.DecodeDate(FDate); //, AYear, AMonth, ADay);
     case Index of
       1: if Year <> Value then Year := Value else Exit;
       2: if (Value <= 12) and (Value <> Month) then Month := Value else Exit;
       3: if (Value <= DaysThisMonth) and (Value <> Day) then Day := Value else Exit;
       else Exit;
     end;
     FDate := fCalSystem.EncodeDate(Year, Month, Day);
     FUseCurrentDate := False;
     UpdateCalendar;
     Change;
     end;
end;

procedure TModCal.SetStartOfWeek(Value: TDayOfWeek);
begin
  if Value <> FStartOfWeek then
  begin
    FStartOfWeek := Value;
    UpdateCalendar;
  end;
end;

procedure TModCal.SetUseCurrentDate(Value: Boolean);
begin
  if Value <> FUseCurrentDate then
  begin
    FUseCurrentDate := Value;
    if Value then
    begin
      FDate := Date; { use the current date, then }
      UpdateCalendar;
    end;
  end;
end;

{ Given a value of 1 or -1, moves to Next or Prev month accordingly }
procedure TModCal.ChangeMonth(Delta: Integer);
var
  YMD : TCalendarDate; //AYear, AMonth, ADay: Word;
  NewDate: TMJD; //DateTime;
  CurDay: Integer;
begin
  YMD := fCalSystem.DecodeDate(FDate); //, AYear, AMonth, ADay);
  with YMD do begin
    CurDay := Day;
    if Delta > 0
      then Day := DaysPerMonth(Year, Month)
      else Day := 1;
    NewDate := fCalSystem.EncodeDate(Year, Month, Day);
    NewDate := NewDate + Delta;
    YMD := fCalSystem.DecodeDate(NewDate);
    if DaysPerMonth(Year, Month) > CurDay
      then Day := CurDay
      else Day := DaysPerMonth(Year, Month);
    CalendarDate := fCalSystem.EncodeDate(Year, Month, Day);
    end;
end;

procedure TModCal.PrevMonth;
begin
  ChangeMonth(-1);
end;

procedure TModCal.NextMonth;
begin
  ChangeMonth(1);
end;

procedure TModCal.NextYear;
begin
  if IsLeapYear(Year) and (Month = 2) and (Day = 29) then Day := 28;
  Year := Year + 1;
end;

procedure TModCal.PrevYear;
begin
  if IsLeapYear(Year) and (Month = 2) and (Day = 29) then Day := 28;
  Year := Year - 1;
end;

procedure TModCal.UpdateCalendar;
var
  YMD : TCalendarDate; //= AYear, AMonth, ADay: Word;
  FirstDate: TMJD; //DateTime;
begin
  FUpdating := True;
  try
    YMD := fCalSystem.DecodeDate(FDate); //, AYear, AMonth, ADay);
    FirstDate := fCalSystem.EncodeDate(Year, Month, 1);
    FMonthOffset := 2 - ((fCalSystem.GetDayOfWeek(FirstDate) - StartOfWeek + 7) mod 7); { day of week for 1st of month }
    if FMonthOffset = 2 then FMonthOffset := -5;
    MoveColRow((Day - FMonthOffset) mod 7, (Day - FMonthOffset) div 7 + 1,
      False, False);
    fDate := fCalSystem.encodeDate(Year, Month, Day);
    Invalidate;
  finally
    FUpdating := False;
  end;
end;

procedure TModCal.WMSize(var Message: TWMSize);
var
  GridLines: Integer;
begin
  GridLines := 6 * GridLineWidth;
  DefaultColWidth := (Message.Width - GridLines) div 7;
  DefaultRowHeight := (Message.Height - GridLines) div 7;
end;

end.